home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln1286.arc / BNCHMARK.ADA / RANDOM.ADA < prev    next >
Text File  |  1986-09-06  |  3KB  |  132 lines
  1. --with SYS_DEP_TIME; -- removed for benchmark only.
  2.  
  3. package RANDOM is
  4.  
  5.     --
  6.     -- Pseudo random number generating routines
  7.     --     Author: Bruce A. Bergman, Aug 1986
  8.     --     These routines are released to the public domain for personal,
  9.     --     non-commercial purposes provided authorship remains unchanged.
  10.     --     Source available from Mark Petersen's Alpo-Net FIDO board at
  11.     --     (619) 741-3412, 300/1200/2400 8,N,1
  12.     --
  13.  
  14.  
  15.     ------------------------------
  16.     -- INITIALIZE_SEED
  17.     ------------------------------
  18.  
  19.     procedure INITIALIZE_SEED(seed : in integer);
  20.     procedure INITIALIZE_SEED(seed : in long_integer);
  21.  
  22.     ------------------------------
  23.     -- RANDOM_NUMBER
  24.     ------------------------------
  25.  
  26.     function RANDOM_NUMBER(high_end : in integer) return integer;
  27.     function RANDOM_NUMBER(high_end : in long_integer) return long_integer;
  28.  
  29. end RANDOM;
  30.  
  31.  
  32. package body RANDOM is
  33.  
  34.     --
  35.     -- Pseudo random number generating routines
  36.     --
  37.  
  38.  
  39.     ------------------------------
  40.     -- declarations
  41.     ------------------------------
  42.  
  43.     a : array (0..54) of long_integer;
  44.     b : constant := 31415821;
  45.     j : integer range 0..54 := 0;
  46.     m : constant := 100000000;
  47.     z : constant := 10000;
  48.  
  49.     ------------------------------
  50.     -- MULT
  51.     ------------------------------
  52.  
  53.     --
  54.     -- Stir up bits.
  55.     --
  56.  
  57.     function MULT(p : in long_integer) return long_integer is
  58.  
  59.         p0, p1, q0, q1 : long_integer;
  60.  
  61.     begin
  62.         p1 := p / z;
  63.         p0 := p mod z;
  64.         q1 := b / z;
  65.         q0 := b mod z;
  66.         return ((((p0 * q1 + p1 * q0) mod z) * z + p0 * q0) mod m);
  67.     end MULT;
  68.  
  69.     ------------------------------
  70.     -- INITIALIZE_SEED
  71.     ------------------------------
  72.  
  73.     --
  74.     -- Set initial seed value (overloaded).
  75.     --
  76.  
  77.     procedure INITIALIZE_SEED(seed : in long_integer) is
  78.  
  79.     begin
  80.         j := 0;
  81.  
  82.         if seed = 0 then
  83.             a(j) := 223729; -- remove this line for actual use.
  84. --          a(j) := SYS_DEP_TIME.get_time; -- removed for benchmark only.
  85.         else
  86.             a(j) := seed;
  87.         end if;
  88.  
  89.         while j /= 54 loop
  90.             j := j + 1;
  91.             a(j) := (mult(a(j-1)) + 1) mod m;
  92.         end loop;
  93.     end INITIALIZE_SEED;
  94.  
  95.     procedure INITIALIZE_SEED(seed : in integer) is
  96.  
  97.     begin
  98.         initialize_seed(long_integer (seed));
  99.     end INITIALIZE_SEED;
  100.  
  101.     ------------------------------
  102.     -- RANDOM_NUMBER
  103.     ------------------------------
  104.  
  105.     --
  106.     -- Random number generator (overloaded).
  107.     --
  108.  
  109.     function RANDOM_NUMBER(high_end : in long_integer) return long_integer is
  110.  
  111.     begin
  112.  
  113.         j := (j+1) mod 55;
  114.         a(j) := (a((j+23) mod 55) + a((j+54) mod 55)) mod m;
  115.         return (((a(j) / z) * high_end) / z);
  116.     end RANDOM_NUMBER;
  117.  
  118.     function RANDOM_NUMBER(high_end : in integer) return integer is
  119.  
  120.     begin
  121.         return integer (random_number(long_integer (high_end)));
  122.     end RANDOM_NUMBER;
  123.  
  124. begin
  125.  
  126.     --
  127.     -- Initialize seed in case application doesn't.
  128.     --
  129.  
  130.     initialize_seed(long_integer (0));
  131. end RANDOM;
  132.